home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / bin / xscreensaver-getimage-file < prev    next >
Encoding:
Text File  |  2007-02-07  |  11.5 KB  |  404 lines
  1. #!/usr/bin/perl -w
  2. # Copyright ⌐ 2001, 2002, 2003, 2004 Jamie Zawinski <jwz@jwz.org>.
  3. #
  4. # Permission to use, copy, modify, distribute, and sell this software and its
  5. # documentation for any purpose is hereby granted without fee, provided that
  6. # the above copyright notice appear in all copies and that both that
  7. # copyright notice and this permission notice appear in supporting
  8. # documentation.  No representations are made about the suitability of this
  9. # software for any purpose.  It is provided "as is" without express or 
  10. # implied warranty.
  11. #
  12. # This program attempts to locate a random image from the specified directory,
  13. # and load it on to the root window, using some other program that can decode
  14. # image files.  (It attempts to find such a program.)
  15. #
  16. # The various xscreensaver hacks that manipulate images ("slidescreen",
  17. # "jigsaw", etc.) get the image to manipulate by running the
  18. # "xscreensaver-getimage" program.
  19. #
  20. # "xscreensaver-getimage" will invoke this program, depending on the
  21. # value of the "chooseRandomImages" and "imageDirectory" settings in
  22. # the ~/.xscreensaver file (or /usr/lib/X11/app-defaults/XScreenSaver).
  23. #
  24. # Created: 12-Apr-01.
  25.  
  26. require 5;
  27. use diagnostics;
  28. use strict;
  29.  
  30. use POSIX;
  31. use Fcntl;
  32.  
  33. use POSIX ':fcntl_h';                # S_ISLNK was here in Perl 5.6
  34. import Fcntl ':mode' unless defined &S_ISLNK;    # but it is here in Perl 5.8
  35.  
  36. use bytes;  # Larry can take Unicode and shove it up his ass sideways.
  37.             # Perl 5.8.0 causes us to start getting incomprehensible
  38.             # errors about UTF-8 all over the place without this.
  39.  
  40. my $progname = $0; $progname =~ s@.*/@@g;
  41. my $version = q{ $Revision: 1.18 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
  42.  
  43. my $verbose = 0;
  44.  
  45. # This matches files that we are allowed to use as images (case-insensitive.)
  46. # Anything not matching this is ignored.  This is so you can point your
  47. # imageDirectory at directory trees that have things other than images in
  48. # them, but it assumes that you gave your images sensible file extensions.
  49. #
  50. my $good_file_re = '\.(gif|p?jpe?g|png|tiff?|xbm|xpm)$';
  51.  
  52. # JPEG, GIF, and PNG files that are are smaller than this size in either
  53. # direction are rejected: this is so that you can use an image directory
  54. # that contains both big images and thumbnails, and have it only select
  55. # the big versions.
  56. #
  57. my $min_image_width  = 255;
  58. my $min_image_height = 255;
  59.  
  60.  
  61. # These are programs that can be used to put an image file on the root
  62. # window (including virtual root windows.)  The first one of these programs
  63. # that exists on $PATH will be used (with the file name as the last arg.)
  64. #
  65. # Generally this isn't used any more; when "xscreensaver-getimage" invokes
  66. # this program, it does so with the "-file" argument (meaning that we just
  67. # return the file name) and then xscreensaver-getimage loads that file
  68. # directly.  However, if you invoke "xscreensaver-getimage-file" directly,
  69. # without "-file", this will be used to actually load the image.
  70. #
  71. my @programs = (
  72.   "chbg       -once -xscreensaver -max_grow 4 -max_size 100",
  73.   "xv         -root -quit -viewonly -maxpect +noresetroot -quick24 -rmode 5" .
  74.   "           -rfg black -rbg black",
  75.   "xli        -quiet -fullscreen -onroot -center -border black",
  76.   "xloadimage -quiet -fullscreen -onroot -center -border black",
  77.  
  78. # this lame program wasn't built with vroot.h:
  79. # "xsri       -scale -keep-aspect -center-horizontal -center-vertical",
  80. );
  81.  
  82.  
  83. sub pick_displayer {
  84.   my @names = ();
  85.  
  86.   foreach my $cmd (@programs) {
  87.     $_ = $cmd;
  88.     my ($name) = m/^([^ ]+)/;
  89.     push @names, "\"$name\"";
  90.     print STDERR "$progname: looking for $name...\n" if ($verbose > 2);
  91.     foreach my $dir (split (/:/, $ENV{PATH})) {
  92.       print STDERR "$progname:   checking $dir/$name\n" if ($verbose > 3);
  93.       return $cmd if (-x "$dir/$name");
  94.     }
  95.   }
  96.  
  97.   $names[$#names] = "or " . $names[$#names];
  98.   printf STDERR "$progname: none of: " . join (", ", @names) .
  99.                 " were found on \$PATH.\n";
  100.   exit 1;
  101. }
  102.  
  103.  
  104. my @all_files = ();     # list of "good" files we've collected
  105. my %seen_inodes;        # for breaking recursive symlink loops
  106. my $skip_count = 0;     # number of files skipped, for diagnostic messages
  107. my $dir_count = 1;      # number of directories seen, for diagnostic messages
  108.  
  109. sub find_all_files {
  110.   my ($dir) = @_;
  111.  
  112.   print STDERR "$progname: reading dir $dir/...\n" if ($verbose > 2);
  113.  
  114.   local *DIR;
  115.   if (! opendir (DIR, $dir)) {
  116.     print STDERR "$progname: couldn't open $dir: $!\n" if ($verbose);
  117.     return;
  118.   }
  119.   my @files = readdir (DIR);
  120.   closedir (DIR);
  121.  
  122.   my @dirs = ();
  123.  
  124.   foreach my $file (@files) {
  125.     next if ($file =~ m/^\./);      # ignore dot files/dirs
  126.  
  127.     $file = "$dir/$file";
  128.     my @st = stat($file);
  129.     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  130.         $atime,$mtime,$ctime,$blksize,$blocks) = @st;
  131.  
  132.     if ($#st == -1) {
  133.       if ($verbose) {
  134.         my $ll = readlink $file;
  135.         if (defined ($ll)) {
  136.           print STDERR "$progname: dangling symlink: $file -> $ll\n";
  137.         } else {
  138.           print STDERR "$progname: unreadable: $file\n";
  139.         }
  140.       }
  141.       next;
  142.     }
  143.  
  144.     next if ($seen_inodes{"$dev:$ino"}); # break symlink loops
  145.     $seen_inodes{"$dev:$ino"} = 1;
  146.  
  147.     if (S_ISDIR($mode)) {
  148.       push @dirs, $file;
  149.       $dir_count++;
  150.       print STDERR "$progname:   found dir  $file\n" if ($verbose > 2);
  151.     } elsif (S_ISREG($mode) || S_ISLNK($mode)) {
  152.  
  153.       if ($file =~ m/[~%\#]$/ ||               # backup file, or
  154.           ! ($file =~ m/$good_file_re/io)) {   # no image extension
  155.         $skip_count++;
  156.         print STDERR "$progname:   skip file $file\n" if ($verbose > 2);
  157.       } else {
  158.         push @all_files, $file;
  159.         print STDERR "$progname:   found file $file\n" if ($verbose > 2);
  160.       }
  161.     } elsif ($verbose > 2) {
  162.       print STDERR "$progname:   nonreg $file\n";
  163.     }
  164.   }
  165.  
  166.   foreach (@dirs) {
  167.     find_all_files ($_);
  168.   }
  169. }
  170.  
  171.  
  172. sub find_random_file {
  173.   my ($dir) = @_;
  174.  
  175.   $dir =~ s@/+$@@g;
  176.  
  177.   print STDERR "$progname: recursively reading $dir...\n" if ($verbose > 1);
  178.   find_all_files ($dir);
  179.   print STDERR "$progname: found " . ($#all_files+1) .
  180.                " file" . ($#all_files == 0 ? "" : "s") .
  181.                " in $dir_count dir" . ($dir_count == 1 ? "" : "s") .
  182.                "; skipped $skip_count file" . ($skip_count == 1 ? "" : "s") .
  183.                ".\n"
  184.     if ($verbose > 1);
  185.  
  186.   @all_files = sort(@all_files);
  187.  
  188.   if ($#all_files < 0) {
  189.     print STDERR "$progname: no files in $dir\n";
  190.     exit 1;
  191.   }
  192.  
  193.   my $max_tries = 50;
  194.   for (my $i = 0; $i < $max_tries; $i++) {
  195.  
  196.     my $n = int (rand ($#all_files + 1));
  197.     my $file = $all_files[$n];
  198.     if (large_enough_p ($file)) {
  199.       return $file;
  200.     }
  201.   }
  202.  
  203.   print STDERR "$progname: no suitable images in $dir " .
  204.                "(after $max_tries tries)\n";
  205.   exit 1;
  206. }
  207.  
  208.  
  209. sub display_file {
  210.   my ($file, $displayer) = @_;
  211.  
  212.   if (!defined($displayer)) {
  213.     print STDOUT "$file\n";
  214.   }  else {
  215.     my @cmd = split (/ +/, $displayer);
  216.     push @cmd, $file;   # do it this way to allow file names with spaces.
  217.     print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
  218.       if ($verbose);
  219.     exec (@cmd) || die;
  220.   }
  221. }
  222.  
  223.  
  224. sub find_and_display {
  225.   my ($dir, $displayer) = @_;
  226.   my $file = find_random_file ($dir);
  227.   display_file ($file, $displayer);
  228. }
  229.  
  230.  
  231. sub large_enough_p {
  232.   my ($file) = @_;
  233.  
  234.   my ($w, $h) = image_file_size ($file);
  235.  
  236.   if (!defined ($h)) {
  237.     print STDERR "$progname: $file: unable to determine image size\n"
  238.       if ($verbose);
  239.     # Assume that unknown files are of good sizes: this will happen if
  240.     # they matched $good_file_re, but we don't have code to parse them.
  241.     # (This will also happen if the file is junk...)
  242.     return 1;
  243.   }
  244.  
  245.   if ($w < $min_image_width || $h < $min_image_height) {
  246.     print STDERR "$progname: $file: too small ($w x $h)\n" if ($verbose > 1);
  247.     return 0;
  248.   }
  249.  
  250.   print STDERR "$progname: $file: $w x $h\n" if ($verbose > 1);
  251.   return 1;
  252. }
  253.  
  254.  
  255.  
  256. # Given the raw body of a GIF document, returns the dimensions of the image.
  257. #
  258. sub gif_size {
  259.   my ($body) = @_;
  260.   my $type = substr($body, 0, 6);
  261.   my $s;
  262.   return () unless ($type =~ /GIF8[7,9]a/);
  263.   $s = substr ($body, 6, 10);
  264.   my ($a,$b,$c,$d) = unpack ("C"x4, $s);
  265.   return (($b<<8|$a), ($d<<8|$c));
  266. }
  267.  
  268. # Given the raw body of a JPEG document, returns the dimensions of the image.
  269. #
  270. sub jpeg_size {
  271.   my ($body) = @_;
  272.   my $i = 0;
  273.   my $L = length($body);
  274.  
  275.   my $c1 = substr($body, $i, 1); $i++;
  276.   my $c2 = substr($body, $i, 1); $i++;
  277.   return () unless (ord($c1) == 0xFF && ord($c2) == 0xD8);
  278.  
  279.   my $ch = "0";
  280.   while (ord($ch) != 0xDA && $i < $L) {
  281.     # Find next marker, beginning with 0xFF.
  282.     while (ord($ch) != 0xFF) {
  283.       return () if (length($body) <= $i);
  284.       $ch = substr($body, $i, 1); $i++;
  285.     }
  286.     # markers can be padded with any number of 0xFF.
  287.     while (ord($ch) == 0xFF) {
  288.       return () if (length($body) <= $i);
  289.       $ch = substr($body, $i, 1); $i++;
  290.     }
  291.  
  292.     # $ch contains the value of the marker.
  293.     my $marker = ord($ch);
  294.  
  295.     if (($marker >= 0xC0) &&
  296.         ($marker <= 0xCF) &&
  297.         ($marker != 0xC4) &&
  298.         ($marker != 0xCC)) {  # it's a SOFn marker
  299.       $i += 3;
  300.       return () if (length($body) <= $i);
  301.       my $s = substr($body, $i, 4); $i += 4;
  302.       my ($a,$b,$c,$d) = unpack("C"x4, $s);
  303.       return (($c<<8|$d), ($a<<8|$b));
  304.  
  305.     } else {
  306.       # We must skip variables, since FFs in variable names aren't
  307.       # valid JPEG markers.
  308.       return () if (length($body) <= $i);
  309.       my $s = substr($body, $i, 2); $i += 2;
  310.       my ($c1, $c2) = unpack ("C"x2, $s);
  311.       my $length = ($c1 << 8) | $c2;
  312.       return () if ($length < 2);
  313.       $i += $length-2;
  314.     }
  315.   }
  316.   return ();
  317. }
  318.  
  319. # Given the raw body of a PNG document, returns the dimensions of the image.
  320. #
  321. sub png_size {
  322.   my ($body) = @_;
  323.   return () unless ($body =~ m/^\211PNG\r/s);
  324.   my ($bits) = ($body =~ m/^.{12}(.{12})/s);
  325.   return () unless defined ($bits);
  326.   return () unless ($bits =~ /^IHDR/);
  327.   my ($ign, $w, $h) = unpack("a4N2", $bits);
  328.   return ($w, $h);
  329. }
  330.  
  331.  
  332. # Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions
  333. # of the image.
  334. #
  335. sub image_size {
  336.   my ($body) = @_;
  337.   my ($w, $h) = gif_size ($body);
  338.   if ($w && $h) { return ($w, $h); }
  339.   ($w, $h) = jpeg_size ($body);
  340.   if ($w && $h) { return ($w, $h); }
  341.   # #### TODO: need image parsers for TIFF, XPM, XBM.
  342.   return png_size ($body);
  343. }
  344.  
  345. # Returns the dimensions of the image file.
  346. #
  347. sub image_file_size {
  348.   my ($file) = @_;
  349.   my $body = '';
  350.   local *IN;
  351.   if (! open (IN, "<$file")) {
  352.     print STDERR "$progname: $file: $!\n" if ($verbose);
  353.     return undef;
  354.   }
  355.   binmode (IN);  # Larry can take Unicode and shove it up his ass sideways.
  356.   while (<IN>) {
  357.     $body .= $_;
  358.     last if (length($body) > 1024 * 100);  # the first 100k should be enough
  359.   }
  360.   close IN;
  361.   return image_size ($body);
  362. }
  363.  
  364.  
  365. sub usage {
  366.   print STDERR "usage: $progname [--verbose] [--name] file-or-directory\n\n" .
  367.   "       Puts the given image file (or a randomly selected image from the\n" .
  368.   "       given directory) on the root window.  If --name is specified,\n" .
  369.   "       just prints the selected filename to stdout instead.\n\n";
  370.   exit 1;
  371. }
  372.  
  373. sub main {
  374.   my $dir = undef;
  375.   my $do_name = 0;
  376.  
  377.   while ($_ = $ARGV[0]) {
  378.     shift @ARGV;
  379.     if ($_ eq "--verbose") { $verbose++; }
  380.     elsif (m/^-v+$/) { $verbose += length($_)-1; }
  381.     elsif ($_ eq "--name") { $do_name++; }
  382.     elsif (m/^-./) { usage; }
  383.     elsif (!defined($dir)) { $dir = $_; }
  384.     else { usage; }
  385.   }
  386.  
  387.   usage unless (defined($dir));
  388.   my $displayer = undef;
  389.  
  390.   $displayer = pick_displayer() unless $do_name;
  391.  
  392.   if (-d $dir) {
  393.     find_and_display ($dir, $displayer);
  394.   } elsif (-f $dir) {
  395.     display_file ($dir, $displayer);
  396.   } else {
  397.     print STDERR "$progname: $dir does not exist\n";
  398.     usage();
  399.   }
  400. }
  401.  
  402. main;
  403. exit 0;
  404.